home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / lib / blocks.f83 < prev    next >
Text File  |  1992-05-19  |  2KB  |  77 lines
  1. \
  2. \  CODE BLOCK DEFINITIONS
  3. \
  4. \  Copyright (C) 1988-1990 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 30 June 1988
  15. \
  16. \  Last updated on: 28 June 1990
  17. \
  18. \  Dependencies:
  19. \       (forth) forth, compiler
  20. \
  21. \  Description:
  22. \       Code blocks as an alternative to passing functions as parameters.
  23. \       Major usage for iterator function such as "map" and "?map".
  24. \
  25. \  Warning:
  26. \       A code block should not contain the following words; "recurse",
  27. \       "tail-recurse", "does>", and "exception>". These require an
  28. \       entry binding to function correctly.
  29. \
  30. \  Copying:
  31. \       This program is free software; you can redistribute it and\or modify
  32. \       it under the terms of the GNU General Public License as published by
  33. \       the Free Software Foundation; either version 1, or (at your option)
  34. \       any later version.
  35. \
  36. \       This program is distributed in the hope that it will be useful,
  37. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  38. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  39. \       GNU General Public License for more details.
  40. \
  41. \       You should have received a copy of the GNU General Public License
  42. \       along with this program; see the file COPYING.  If not, write to
  43. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  44.  
  45. .( Loading Blocks definitions...) cr
  46.  
  47. vocabulary blocks ( -- )
  48.  
  49. compiler blocks definitions
  50.  
  51. 4 cells field +block ( addr -- block) private
  52.  
  53. : block[ ( -- )
  54.   compiling                ( Check interpreter state)
  55.   if here +block [compile] literal    ( If compiling then create literal)
  56.     compile (branch) >mark        ( to code section and branch over)
  57.     true                ( Mark code compilation state)
  58.   else
  59.     here                ( Return pointer to code section)
  60.     false                ( Mark non-code compilation state)
  61.     ]                    ( Start compiling code for block)
  62.     then
  63. ; immediate
  64.  
  65. : ]; ( -- block)
  66.   [compile] ;                ( Compile what semicolon does)
  67.   if >resolve                ( If within code resolve branch)
  68.     ]                    ( And Continue compiling)
  69.   then
  70. ; immediate
  71.  
  72. : call ( block -- )
  73.   >r                     ( Perform the block definition)
  74. ;
  75.  
  76. forth only
  77.